home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr43 / ppl4p10.zip / AMODEM.PAS next >
Pascal/Delphi Source File  |  1995-02-20  |  10KB  |  343 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*       --- ASCII Protocol ---              *)
  4. (*                                           *)
  5. (*  This program is donated to the Public    *)
  6. (*  Domain by MarshallSoft Computing, Inc.   *)
  7. (*  It is provided as an example of the use  *)
  8. (*  of the Personal Communications Library.  *)
  9. (*                                           *)
  10. (*********************************************)
  11.  
  12. { $DEFINE DEBUG}
  13. {$I DEFINES.PAS}
  14.  
  15. unit amodem;
  16.  
  17. interface
  18.  
  19. uses term_io,PCL4P,crt,xypacket,file_io;
  20.  
  21. (* reference 'file_io' to get BufferType definition *)
  22.  
  23. function TxAscii(
  24.          Port     : Integer;     (* COM port [0..3] *)
  25.      Var Filename : String;      (* filename buffer *)
  26.          CharPace : Integer;     (* delay between characters (timer tics) *)
  27.          TermChar : Byte;        (* termination character ($00 => none) *)
  28.          TimeOut  : Integer;     (* delay after which assume sender is done (secs) *)
  29.          EchoFlag : Boolean)     (* local echo flag *)
  30.          : Boolean;
  31.  
  32. function RxAscii(
  33.          Port     : Integer;     (* COM port [0..3] *)
  34.      Var Filename : String;      (* filename buffer *)
  35.          TermChar : Byte;        (* termination character ($00 => none) *)
  36.          TimeOut  : Integer;     (* delay after which assume sender is done (secs) *)
  37.          EchoFlag : Boolean)     (* local echo flag *)
  38.          : Boolean;
  39.  
  40. implementation
  41.  
  42. Const
  43.      XON  = $11;
  44.      XOFF = $13;
  45.      CAN  = $18;
  46.      ESC  = $1B;
  47.      ONE_SECOND  = 18;
  48.  
  49. Var  (* globals *)
  50.      LastXchar : Byte;          (* last XON or XOFF *)
  51.      LastTime  : LongInt;       (* last time character was received *)
  52.      DataCount : Integer;       (* # bytes in Buffer *)
  53.      TheTermChar : Byte;
  54.  
  55. Procedure DiskError;
  56. Begin
  57.   WriteMsg('Disk I/O Error');
  58.   fioClose
  59. End;
  60.  
  61. procedure ReportBytes(Bytes : LongInt);
  62. var
  63.   Message : String[50];
  64. begin
  65.   Str(Bytes,Message);
  66.   Message := 'Ascii: ' + Message + ' bytes.';
  67.   WriteMsg(Message);
  68. end;
  69.  
  70. function UserQuits(Port : Integer) : Boolean;
  71. var
  72.   UserChar : Char;
  73.   Code     : Integer;
  74. begin
  75.   (* does user want to quit ? *)
  76.   UserQuits := FALSE;
  77.   if KeyPressed then
  78.     begin
  79.       UserChar := ReadKey;
  80.       if Ord(UserChar) = CAN then
  81.         begin
  82.           TxCAN(Port);
  83.           Code := SioPutc(Port,chr(TheTermChar));
  84.           WriteMsg('Ascii: Aborted by USER...');
  85.           UserQuits := TRUE
  86.         end
  87.       else Code := SioPutc(Port,UserChar);
  88.     end
  89. end;
  90.  
  91. function CheckForXOFF(Port:Integer) : Boolean;
  92. Var
  93.   Code : Integer;
  94. begin
  95.   (* check for incoming XOFF *)
  96.   Code := GetChar(Port,0);
  97.   if Code = XOFF then
  98.     begin
  99.       (* received a XOFF *)
  100.       WriteMsg('Ascii: XOFF received');
  101.       LastXchar := XOFF;
  102.       CheckForXOFF := TRUE;
  103.     end
  104.   else CheckForXOFF := FALSE
  105. end;
  106.  
  107. function WaitForXON(Port:Integer;TimeOut:Integer) : Boolean;
  108. Var
  109.   Code : Integer;
  110.   ExitFlag : Boolean;
  111. begin
  112.   LastTime := SioTimer;
  113.   ExitFlag := FALSE;
  114.   repeat
  115.     Code := GetChar(Port,ONE_SECOND);
  116.     if Code = -1 then
  117.       begin
  118.         (* nothing there *)
  119.         if SioTimer-LastTime > 60*ONE_SECOND then
  120.           begin
  121.             (* we have timed out *)
  122.             WriteMsg('Ascii: Timed out waiting for XON');
  123.             WaitForXON := FALSE;
  124.             ExitFlag := TRUE;
  125.           end
  126.       end
  127.     else
  128.       (* character received *)
  129.       begin
  130.         if Code = XON then
  131.           begin
  132.             (* received character was XON *)
  133.             WriteMsg('Ascii: XON received');
  134.             LastXchar := XON;
  135.             WaitForXON := TRUE;
  136.             ExitFlag := TRUE;
  137.           end
  138.         else
  139.           begin
  140.             (* received character wasn't a XON *)
  141.             WriteMsg('Ascii: Received character not XON');
  142.           end
  143.       end
  144.   until ExitFlag;
  145. end;
  146.  
  147. procedure CheckQueue(Port,LoMark,HiMark:Integer);
  148. var
  149.   QueueSize : Integer;
  150. begin
  151.   QueueSize := SioRxQue(Port);
  152.   if (QueueSize>HiMark) and (LastXchar=XON) then
  153.     begin
  154.       PutChar(Port,XOFF);
  155.       LastXchar := XOFF;
  156.       WriteMsg('Ascii: Sending XOFF')
  157.     end;
  158.   if (QueueSize<LoMark) and (LastXchar=XOFF) then
  159.     begin
  160.       PutChar(Port,XON);
  161.       LastXchar := XON;
  162.       WriteMsg('Ascii: Sending XON')
  163.     end
  164. end;
  165.  
  166. function TxAscii(
  167.          Port     : Integer;     (* COM port [0..3] *)
  168.      Var Filename : String;      (* filename buffer *)
  169.          CharPace : Integer;     (* millisecond delay between characters *)
  170.          TermChar : Byte;        (* termination character ($00 => none) *)
  171.          TimeOut  : Integer;     (* delay after which assume sender is done *)
  172.          EchoFlag : Boolean)     (* local echo flag *)
  173.          : Boolean;
  174. Var
  175.   Buffer : BufferType;
  176.   i      : Integer;
  177.   Code   : Integer;
  178.   c      : Char;
  179.   TheByte   : Byte;
  180.   BytesRead : Word;
  181.   ExitFlag  : Boolean;
  182.   TxChars   : LongInt;
  183.   Message   : String[50];
  184. begin
  185.   TheTermChar := TermChar;
  186.   if not fioOpen(Filename) then
  187.     begin
  188.       Message := 'Ascii: Cannot open ' + Filename;
  189.       WriteMsg(Message);
  190.       TxAscii := FALSE;
  191.       exit;
  192.     end;
  193.   (* start ascii send *)
  194.   WriteMsg('Ascii: Starting SEND');
  195.   LastXchar := XON;
  196.   ExitFlag := FALSE;
  197.   TxChars := 0;
  198.   (* flush keyboard & serial port *)
  199.   while KeyPressed do c := ReadKey;
  200.   Code := SioRxFlush(Port);
  201.   (* send ascii file *)
  202.   repeat
  203.     (* does user want to quit ? *)
  204.     if UserQuits(Port) then exit;
  205.     (* read next buffer from disk *)
  206.     if not fioRead(Buffer,1024,BytesRead) then
  207.       begin
  208.         DiskError;
  209.         TxAscii := False;
  210.         exit
  211.       end;
  212.     (* send 1 character at a time *)
  213.     for i := 0 to BytesRead-1 do
  214.       begin
  215.         (* send character & delay *)
  216.         TheByte := Buffer[i];
  217.         PutChar(Port,TheByte);
  218.         if EchoFlag then write(chr(TheByte));
  219.         if CharPace > 0 then SioDelay(CharPace);
  220.         if TheByte = $0d then SioDelay(5);
  221.         TxChars := TxChars + 1;
  222.         if (TxChars mod 100) = 0 then ReportBytes(TxChars);
  223.         (* check for incoming XOFF *)
  224.         if CheckForXOFF(Port) then
  225.           begin
  226.             (* received XOFF, so wait for XON *)
  227.             if not WaitForXON(Port,TimeOut) then ExitFlag := TRUE;
  228.           end
  229.       end;
  230.   until ExitFlag or (BytesRead = 0);
  231.   (* send termination character, if any *)
  232.   if TermChar <> $00 then
  233.     begin
  234.       PutChar(Port,TermChar);
  235.       WriteMsg('Ascii: Termination character sent');
  236.     end;
  237.   fioClose;
  238.   TxAscii := True
  239. end; (* TxAscii *)
  240.  
  241. function RxAscii(
  242.          Port     : Integer;     (* COM port [0..3] *)
  243.      Var Filename : String;      (* filename buffer *)
  244.          TermChar : Byte;        (* termination character ($00 => none) *)
  245.          TimeOut  : Integer;     (* delay after which assume sender is done *)
  246.          EchoFlag : Boolean)     (* local echo flag *)
  247.          : Boolean;
  248. Const
  249.   RxBufSize = 1024;
  250. Var
  251.   Buffer  : BufferType;
  252.   c       : Char;
  253.   i, k    : Integer;
  254.   Code    : Integer;      (* return code *)
  255.   Flag    : Boolean;
  256.   Message : String;
  257.   Temp    : String;
  258.   Result  : Integer;
  259.   LoMark   : Integer;     (* receive buffer low water mark *)
  260.   HiMark   : Integer;     (* receive buffer high water mark *)
  261.   ExitFlag : Boolean;
  262.   RxChars  : LongInt;
  263.   (* begin *)
  264. begin
  265.   TheTermChar := TermChar;
  266.   if not fioCreate(Filename) then
  267.     begin
  268.       Message := 'Ascii: Cannot open ' + Filename;
  269.       WriteMsg(Message);
  270.       RxAscii := FALSE;
  271.       exit
  272.     end;
  273.   (* flush keyboard & serial port *)
  274.   while KeyPressed do c := ReadKey;
  275.   Code := SioRxFlush(Port);
  276.   (* receive text *)
  277.   WriteMsg('Ascii: Starting RECEIVE');
  278.   LoMark := RxBufSize div 8;
  279.   HiMark := 5 * LoMark;
  280.   LastXchar := XON;
  281.   DataCount := 0;
  282.   RxChars := 0;
  283.   ExitFlag := FALSE;
  284.   repeat
  285.     (* does user want to quit ? *)
  286.     if UserQuits(Port) then exit;
  287.     (* check receive queue size *)
  288.     CheckQueue(Port,LoMark,HiMark);
  289.     (* get next character *)
  290.     if RxChars = 0 then
  291.       begin
  292.         (* wait 1 minute for 1st character *)
  293.         Code := GetChar(Port,60*ONE_SECOND);
  294.         LastTime := SioTimer
  295.       end
  296.     else Code := GetChar(Port,TimeOut*ONE_SECOND);
  297.     (* did we timeout ? *)
  298.     if Code = -1 then
  299.       begin
  300.         (* we have timed out ! *)
  301.         ExitFlag := TRUE;
  302.         WriteMsg('Ascii: Timeout.');
  303.       end;
  304.     (* termination character ? *)
  305.     if (Code <> -1) and (TermChar<>$00) and (Code=TermChar) then
  306.       begin
  307.         (* received termination character *)
  308.         ExitFlag := TRUE;
  309.         WriteMsg('Ascii: Termination character received');
  310.       end
  311.     else
  312.       begin
  313.         RxChars := RxChars + 1;
  314.         if EchoFlag then write(chr(Code));
  315.         if (RxChars mod 100) = 0 then ReportBytes(RxChars);
  316.         (* put character in buffer *)
  317.         Buffer[DataCount] := Code;
  318.         DataCount := DataCount + 1;
  319.         if DataCount = 1024 then
  320.           begin
  321.             if not fioWrite(Buffer,DataCount) then
  322.               begin
  323.                 DiskError;
  324.                 RxAscii := False;
  325.                 exit
  326.               end;
  327.             DataCount := 0;
  328.           end
  329.       end
  330.   until ExitFlag;
  331.   (* flush the data buffer *)
  332.   if DataCount > 0 then if not fioWrite(Buffer,DataCount) then
  333.     begin
  334.       DiskError;
  335.       RxAscii := False;
  336.       exit
  337.     end;
  338.   (* close the output file *)
  339.   fioClose;
  340.   RxAscii := True
  341. end; (* end - RxAscii *)
  342.  
  343. end.